home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / fortran / libry51.zip / LIBRY4C.DOC < prev    next >
Text File  |  1989-11-10  |  17KB  |  586 lines
  1. .de
  2. .pa
  3.         EXAMPLE ILLUSTRATING THE USE OF BFNLQ, BRYDN, CONJG, AND NTNLQ
  4.  
  5.  
  6. $STORAGE:2
  7.       PROGRAM EXAMPLE1
  8. C
  9. C  compare methods for solving nonlinear simultaneous equations
  10. C
  11.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  12.       LOGICAL*2 LXXX87
  13.       CHARACTER SFILE*12
  14. C
  15. C  list heading
  16. C
  17.       CALL WRTTY('TESTNLEQ/V1.0: comparison of various nonlinear_')
  18.       CALL WRTTY(' simultaneous equation solvers<')
  19.       CALL WRTTY('by Dudley J. Benton, TVA Lab, P.O. Drawer E,_')
  20.       CALL WRTTY(' Norris, TN (615) 632-1887<')
  21. C
  22. C  fetch optional spool file name from runtime string (default to CRT)
  23. C
  24.       CALL RRPAR(1,SFILE)
  25.       IF(SFILE.EQ.' ') SFILE='CON'
  26. C
  27. C  spool printer output (don't bother if it is already going there,
  28. C  although this won't hurt anything if you do it anyway)
  29. C
  30.       IF(SFILE.NE.'PRN ') THEN
  31.         CALL SPOOL(SFILE,IER)
  32.         IF(IER.NE.0) GO TO 999
  33.       ENDIF
  34. C
  35.       IF(SFILE.NE.'CON ') THEN
  36.         CALL FFPRN
  37.         CALL WRPRN('TESTNLEQ/V1.0: comparison of various nonlinear_')
  38.         CALL WRPRN(' simultaneous equation solvers<')
  39.         CALL WRPRN('by Dudley J. Benton, TVA Lab, P.O. Drawer E,_')
  40.         CALL WRPRN(' Norris, TN (615) 632-1887<')
  41.       ENDIF
  42. C
  43. C  test for math coprocessor
  44. C
  45.       IF(.NOT.LXXX87(0)) THEN
  46.         CALL WRTTY('What, no coprocessor?  You gotta be kidding!<')
  47.         CALL WRTTY('Find a good book to read while you wait!<')
  48.       ENDIF
  49. C
  50. C  notify user of optional break
  51. C
  52.       CALL WRTTY('<')
  53.       CALL WRTTY('You can tap the space bar to interrupt processing.<')
  54. C
  55. C  test single precision routines
  56. C
  57.       CALL SINGL
  58. C
  59. C  test double precision routines
  60. C
  61.       CALL DOUBL
  62. C
  63. C  return printer output to PRN
  64. C
  65.       CALL WRTTY('<')
  66.       IF(SFILE.NE.'PRN') CALL SPOOL('PRN ',IER)
  67. C
  68.       CALL WRTTY('Thanks  for using TESTNLEQ  have a nice day <')
  69.       CALL WRTTY('<')
  70. C
  71. C                 HZ beats
  72.       CALL TONE( 784,  1)
  73.       CALL TONE( 988,  1)
  74.       CALL TONE(1047,  1)
  75.       CALL TONE( 524,  2)
  76. C
  77.   999 STOP
  78.       END
  79.       SUBROUTINE SINGL
  80. C
  81. C  test methods for solving nonlinear simultaneous equations
  82. C  (single precision)
  83. C
  84.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  85. C
  86. C  set parameters up for the maximum
  87. C
  88.       PARAMETER (N=4,M=9,MW=6*N+5*M+N*N+M*N)
  89.       DIMENSION XMIN(N),XMAX(N),X(N),F(M),WORK(MW)
  90.       EXTERNAL USER1,USER2,USER3,USER4,USER5,USER6
  91.       DATA XMIN/N*.001E0/
  92.       DATA XMAX/N*.999E0/
  93.       DATA MCALL,IPRT/9999,1/
  94. C
  95.       CALL WRPRN('<')
  96.       CALL WRPRN('TESTING SINGLE PRECISION ROUTINES<')
  97. C
  98.       CALL WRPRN('Brute Force Method<')
  99.       CALL BFNLQ(USER1,XMIN,XMAX,X,F,2,2,WORK,MW,MCALL,IPRT,IER)
  100.       CALL BFNLQ(USER2,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  101.       CALL BFNLQ(USER3,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  102.       CALL BFNLQ(USER4,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  103.       CALL BFNLQ(USER5,XMIN,XMAX,X,F,4,4,WORK,MW,MCALL,IPRT,IER)
  104.       CALL BFNLQ(USER6,XMIN,XMAX,X,F,4,9,WORK,MW,MCALL,IPRT,IER)
  105. C
  106.       CALL WRPRN('Newton''s Method<')
  107.       CALL NTNLQ(USER1,XMIN,XMAX,X,F,2,2,WORK,MW,MCALL,IPRT,IER)
  108.       CALL NTNLQ(USER2,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  109.       CALL NTNLQ(USER3,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  110.       CALL NTNLQ(USER4,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  111.       CALL NTNLQ(USER5,XMIN,XMAX,X,F,4,4,WORK,MW,MCALL,IPRT,IER)
  112.       CALL NTNLQ(USER6,XMIN,XMAX,X,F,4,9,WORK,MW,MCALL,IPRT,IER)
  113. C
  114.       CALL WRPRN('Conjugate Gradient Method<')
  115.       CALL CONJG(USER1,XMIN,XMAX,X,F,2,2,WORK,MW,MCALL,IPRT,IER)
  116.       CALL CONJG(USER2,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  117.       CALL CONJG(USER3,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  118.       CALL CONJG(USER4,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  119.       CALL CONJG(USER5,XMIN,XMAX,X,F,4,4,WORK,MW,MCALL,IPRT,IER)
  120.       CALL CONJG(USER6,XMIN,XMAX,X,F,4,9,WORK,MW,MCALL,IPRT,IER)
  121. C
  122.       CALL WRPRN('Modified Broyden''s Method<')
  123.       CALL BRYDN(USER1,XMIN,XMAX,X,F,2,2,WORK,MW,MCALL,IPRT,IER)
  124.       CALL BRYDN(USER2,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  125.       CALL BRYDN(USER3,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  126.       CALL BRYDN(USER4,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  127.       CALL BRYDN(USER5,XMIN,XMAX,X,F,4,4,WORK,MW,MCALL,IPRT,IER)
  128.       CALL BRYDN(USER6,XMIN,XMAX,X,F,4,9,WORK,MW,MCALL,IPRT,IER)
  129. C
  130.       RETURN
  131.       END
  132.       SUBROUTINE USER1(X,F)
  133. C
  134. C  user-defined functional which is to be minimized by selecting X
  135. C  the exact solution to this is [X]=[.1,.2]
  136. C
  137.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  138.       DIMENSION X(2),F(2)
  139. C
  140.       X1=X(1)*5.000000E0
  141.       X2=X(2)*4.330127E0
  142. C
  143.       F(1)=3E0*X1**2-X2**2
  144.       F(2)=3E0*X1*X2**2-X1**3-1E0
  145. C
  146.       RETURN
  147.       END
  148.       SUBROUTINE USER2(X,F)
  149. C
  150. C  user-defined functional which is to be minimized by selecting X
  151. C  the exact solution to this is [X]=[.1,.2,.3]
  152. C
  153.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  154.       DIMENSION X(3),F(3)
  155.       PARAMETER (PI=3.1415926E0)
  156. C
  157.       X1=X(1)*5E0
  158.       X2=X(2)-.2E0
  159.       X3=-PI*X(3)/1.8E0
  160. C
  161.       F(1)=3E0*X1-COS(X2*X3)-.5E0
  162.       F(2)=X1**2-81E0*(X2+.1E0)**2+SIN(X3)+1.06E0
  163.       F(3)=EXP(-X1*X2)+20E0*X3+(10E0*PI-3E0)/3E0
  164. C
  165.       RETURN
  166.       END
  167.       SUBROUTINE USER3(X,F)
  168. C
  169. C  user-defined functional which is to be minimized by selecting X
  170. C  the exact solution to this is [X]=[.1,.2,.3]
  171. C
  172.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  173.       DIMENSION X(3),F(3)
  174. C
  175.       X1=X(1)-.1E0
  176.       X2=X(2)/2E0
  177.       X3=X(3)/.3E0
  178. C
  179.       F(1)=X1+COS(X1*X2*X3)-1E0
  180.       F(2)=ABS(1E0-X1)**.25+X2+.05E0*X3**2-.15E0*X3-1E0
  181.       F(3)=-X1**2-.1E0*X2**2+.01E0*X2+X3-1E0
  182. C
  183.       RETURN
  184.       END
  185.       SUBROUTINE USER4(X,F)
  186. C
  187. C  user-defined functional which is to be minimized by selecting X
  188. C  the exact solution to this is [X]=[.1,.2,.3]
  189. C
  190.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  191.       DIMENSION X(3),F(3)
  192. C
  193.       X1=X(1)*8.77129E0/.1E0
  194.       X2=X(2)*.259695E0/.2E0
  195.       X3=X(3)*(-1.37228E0)/.3E0
  196. C
  197.       F(1)=X1*EXP(X2*1E0)+X3*1E0-10E0
  198.       F(2)=X1*EXP(X2*2E0)+X3*2E0-12E0
  199.       F(3)=X1*EXP(X2*3E0)+X3*3E0-15E0
  200. C
  201.       RETURN
  202.       END
  203.       SUBROUTINE USER5(X,F)
  204. C
  205. C  user-defined functional which is to be minimized by selecting X
  206. C  the exact solution to this is [X]=[.1,.2,.3,.4]
  207. C
  208.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  209.       DIMENSION X(4),F(4)
  210. C
  211.       X1=X(1)*1.2E0/.1E0
  212.       X2=X(2)*5.6E0/.2E0
  213.       X3=X(3)*4.3E0/.3E0
  214.       X4=X(4)*1.0E0/.4E0
  215. C
  216.       F(1)=X1+2E0*X2+X3+4E0*X4-20.7E0
  217.       F(2)=X1**2+2E0*X1*X2+X4**3-15.88E0
  218.       F(3)=X1**3+X3**2+X4-21.218E0
  219.       F(4)=3E0*X2+X3*X4-21.1E0
  220. C
  221.       RETURN
  222.       END
  223.       SUBROUTINE USER6(X,F)
  224. C
  225. C  user-defined functional which is to be minimized by selecting X
  226. C  the exact solution to this is [X]=[.1,.2,.3,.4]
  227. C
  228.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  229.       DIMENSION X(4),F(9),T(9),A(9)
  230.       DATA T/1.,2.,3.,4.,5.,6.,7.,8.,9./
  231.       DATA A/2.14737,1.69412,1.2,.64615,.0,-.8,-1.88571,-3.6,-7.2/
  232. C
  233.       CA= 3.*X(1)
  234.       T1=25.*X(2)
  235.       T0=35.*X(3)
  236.       T2=45.*X(4)
  237. C
  238.       DO 100 I=1,9
  239.   100 F(I)=CA*(T(I)-T1)*(T(I)-T2)/(T0-T(I))-A(I)
  240. C
  241.       RETURN
  242.       END
  243.       SUBROUTINE DOUBL
  244. C
  245. C  test methods for solving nonlinear simultaneous equations
  246. C  (double precision)
  247. C
  248.       IMPLICIT INTEGER*2(I-N),REAL*8(A-H,O-Z)
  249. C
  250. C  set parameters up for the maximum
  251. C
  252.       PARAMETER (N=4,M=9,MW=6*N+5*M+N*N+M*N)
  253.       DIMENSION XMIN(N),XMAX(N),X(N),F(M),WORK(MW)
  254.       EXTERNAL USERD1,USERD2,USERD3,USERD4,USERD5,USERD6
  255.       DATA XMIN/N*.001D0/
  256.       DATA XMAX/N*.999D0/
  257.       DATA MCALL,IPRT/9999,1/
  258. C
  259.       CALL WRPRN('<')
  260.       CALL WRPRN('TESTING DOUBLE PRECISION ROUTINES<')
  261. C
  262.       CALL WRPRN('Brute Force Method<')
  263.       CALL BFNLQD(USERD1,XMIN,XMAX,X,F,2,2,WORK,MW,MCALL,IPRT,IER)
  264.       CALL BFNLQD(USERD2,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  265.       CALL BFNLQD(USERD3,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  266.       CALL BFNLQD(USERD4,XMIN,XMAX,X,F,3,3,WORK,MW,MCALL,IPRT,IER)
  267.       CALL BFNLQD(USERD5,XMIN,XMAX,X,F,4,4,WORK,MW,MCALL,IPRT,IER)
  268.       CALL BFNLQD(USERD6,XMIN,X